perm filename PERSP.OLD[CMS,LCS]1 blob sn#719081 filedate 1983-07-04 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		IMPLICIT INTEGER(X,Y,Z)
C00007 ENDMK
CāŠ—;
	IMPLICIT INTEGER(X,Y,Z)
	DIMENSION X1(800),Y1(800),Z1(800)
	DIMENSION X2(800),Y2(800),Z2(800)
	DIMENSION X3(800),Y3(800)
	1  ,JJ(4000)
 
	JHALF=0
1	FORMAT(' TYPE INPUT NAME 1 '$)
2	FORMAT(' TYPE INPUT NAME 2 '$)
3	FORMAT(' TYPE OUTPUT NAME '$)
6	FORMAT(A5)
7	FORMAT(4I)
8	FORMAT(' TYPE X,Y FOR VANISHING POINT. '$)
9	FORMAT(' TYPE FORESHORTENING FACTOR. '$)
13	FORMAT(F)
4	TYPE 1
	ACCEPT 6,NM1
	TYPE 2
	ACCEPT 6,NM2
20	REWIND 1
	REWIND 20
	CALL IFILE(1,NM1)
	CALL IFILE(20,NM2)
	DO 30 KT=1,800
30	READ(1,7,END=21)LT,X1(KT),Y1(KT),Z1(KT)
C NOW KT = TOTAL VECTORS +1
21	J=X2(1)
	JB=J
	LB=Y2(1)
	LT=L
	DO 40 K=1,800
	READ(20,7,END=22)LT,X2(K),Y2(K),Z2(K)
	N=X2(K)
	IF(N.LT.J)J=N
	IF(N.GT.JB)JB=N
C ASSUMES BASE LINE IS LEVEL FOR NOW
	N=Y2(K)
	IF(N.LT.LB)LB=N
40	IF(N.GT.LT)LT=N
C GETS TOP AND BOT.  LT,LB
22	K=K-1
CC	IF(LB.GE.0)GO TO 200
CC	DO 201 J=1,K
CC201	Y2(J)=Y2(J)-LB
CC	DO 202 J=1,KT-1
CC202	Y1(J)=Y1(J)-LB
C SHIFT ALL TO Y POSITIVE IF ANY NEG POINTS
200	CALL DPYSET(1,JJ,4000)
  	CALL DRWIT(X2,Y2,Z2,K)
  	CALL DRWIT(X1,Y1,Z1,KT-1)
23	FORMAT(' HORIZONTAL POINTS ARE ',2I4)
24	FORMAT('  VERTICAL  POINTS ARE ',2I4)
	TYPE 23,J,JB
	TYPE 24,LB,LT
	AX=LB
	BX=LT
	AY=J
	BY=JB
	TYPE 8
	ACCEPT 7,X,Y
	CALL AIVECT(X2(K)-100,Y2(K))
	CALL AVECT(X-100,Y)
	CALL AVECT(X2(1)-100,Y2(1))
	CALL DPYOUT(1)
C SHOWS VANISHING POINT
	TYPE 9
	ACCEPT 13,F
	HA=Y2(K)-Y
C HEIGHT FROM VP TO TOP OF RECT.
	HB=Y2(1)-Y
C HEIGHT FROM VP TO BOT OF RECT.
	DL=X-X2(1)
C LENGTH FROM LEFT EDGE OF RECT. TO VP
	M1=1
	M2=1
C GET FIRST POINTS
C G,LT=TOP OF RECT.  H,LB=BOT OF RECT.
	G=LT
	H=LB
	D=G-H
C D=HEIGHT OF RECT.
10	RZ=(Y1(M1)-LB)/D
C RZ= THIS POINT % OF HEIGHT IN RECT.
C NOW FIND HEIGHT IN RE. TO VANISHING POINT.
	XA=X-X1(M1)
	XA=XA*(XA**F)/(DL**F)
	A=XA/DL
CCC	A=(X-X1(M1))/DL
C THIS POINT'S % OF THAT LENGTH
11	RQ=A*HA+Y
C POINT OF INTERSECTION WITH TOP LINE TO VP
	RR=A*HB+Y
C POINT OF INTERSECTION WITH BOT LINE TO VP
	DQ=RQ-RR
C LENGTH OF INTERSECTING VERTICAL SEGMENT
	LY=RZ*DQ+RR
	IF(IABS(LY).GE.1000)JHALF=-1
	Y3(M1)=LY
C VERTICAL POINT, SCALED TO VP.
	LX=X-XA
	IF(IABS(LX).GE.1000)JHALF=-1
	X3(M1)=LX
CCC	X3(M1)=X1(M1)
C NO X CHAGE FOR TIME BEING
12	M1=M1+1
	IF(M1.LT.KT)GO TO 10
 	CALL DRWIT(X3,Y3,Z1,KT-1)
300	FORMAT(' WRITE FILE? ')
	TYPE 300
	ACCEPT 6,J
	IF(J.NE.'Y')GO TO 301
	TYPE 3
	ACCEPT 6,J
	CALL OFILE(21,J)
	IF(JHALF.NE.0)GO TO 304
	DO 302 J=1,KT-1
302	WRITE(21,7)J,X3(J),Y3(J),Z1(J)
C WRITES FILE TO BE USED WITH 'RE' IN THE DRW PROGRAM.
303	JHALF=0
	END FILE 21
301	CALL HYDPOG(1)
	GO TO 200
304	DO 305 J=1,KT-1
C HALF SIZE IF X OR Y .GE.1000
	LX=X3(J)/2
	LY=Y3(J)/2
305	WRITE(21,7)J,LX,LY,Z1(J)
	GO TO 303
	END 

	SUBROUTINE DRWIT(X,Y,Z,K)
	INTEGER X,Y,Z
	DIMENSION X(1),Y(1),Z(1)
	DO 1 J=1,K
	IF(Z(J).EQ.0)GO TO 2
	CALL AIVECT(X(J)-100,Y(J))
	GO TO 1
2 	CALL AVECT(X(J)-100,Y(J))
1 	CONTINUE
	CALL DPYOUT(1)
	END